#   Copyright 2013 Stacy Doss stacy.doss@gmail.com
#
#   Licensed under the Apache License, Version 2.0 (the "License");
#   you may not use this file except in compliance with the License.
#   You may obtain a copy of the License at
#
#       http://www.apache.org/licenses/LICENSE-2.0
#
#   Unless required by applicable law or agreed to in writing, software
#   distributed under the License is distributed on an "AS IS" BASIS,
#   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
#   See the License for the specific language governing permissions and
#   limitations under the License.
   
package DIME;

use strict;
use warnings;

use Storable (qw/dclone store retrieve/);
use Data::Dumper;
use DIME::Utility;
use DIME::View;
use DIME::Data;
use Tk;

$Data::Dumper::Indent = 1;
$Data::Dumper::Terse  = 1;
$Data::Dumper::Purity = 1;
$|=1;

#####
# AUTOLOAD - used to map bind functions
#
#sub AUTOLOAD {
#	my $sub = $DIME::AUTOLOAD;
#
#	$sub =~ s/.*:://;
#
#	# bind and bind_ renamer
#	if ($sub =~ s/^bind_?(\S+)/$1/) {
#		
#		# Save binding widget
#		$::global->{'bind'} = shift @_;
#
#		# Call base sub
#		my $val = &{$sub}(@_) ;
#
#		# Remove binding widget
#		$::global->{'bind'} = undef;
#
#		return $val;
#	}
#
#	my $lcsub = lc $sub;
#	my $self = shift;
#	if (defined $self and $self->can($lcsub)) {
#		return $self->$lcsub(@_);
#	}

#	# Die horriably if unknown sub
#	die "Unknown sub $sub in DIME.pm";
#}

#####
# new - Set up a new DIME object, creates the gui and assigns root if applicable
#
sub new {
	my $class = shift;
    my $data  = shift || {};     
    my $self = {};
    
	bless $self, $class;

    $self->{GUI}  = new DIME::View($self);
    $self->{DATA} = new DIME::Data($self);

    $self->cmdNew($data);
    $self->cmdLoadOptions();

    return $self;
}



sub DESTROY {}



sub cmdExit {
    my $self = shift;
	$self->{GUI}->destroy();
    
}



sub cmdLoadOptions {
    my $self = shift;
	my $config = $self->{DATA}->loadConfig();

    my $options = $config->getOptionNames();

    for my $o (@{$options}) {
        my $v = $config->getOption($o);
        $self->{GUI}->showOption($o, $v);
    }
}



sub cmdNew {
    my $self = shift;
    my $data = shift;

    $self->{DATA}->setData($data);
    $self->{GUI}->removeDataFromViews();
    $self->{GUI}->populateRoot($data);
    
    # L@@K Old code, need to think about this a little
#	$self->{active} = 0;
#
#	# Set globals
#	$self->{filename} = 'untitled';
    
}



sub cmdOpen {
    my $self = shift;

    my $save = $self->{current_filename};
	$self->{current_filename} = $self->{GUI}->getOpenFilename();

    if ($self->{current_filename} =~ /\.psr$/) {
        $self->cmdNew(retrieve $self->{current_filename});   
    } elsif ($self->{current_filename} =~ /\.ddd$/) {
        $self->cmdNew(do $self->{current_filename});
    } else {
        $self->{GUI}->Error("Invalid file");
        $self->{current_filename} = $save;
    }
}



sub cmdSave {
    my $self = shift;

    if ($self->{current_filename}) {
        my $data = $self->getData()->getRoot(); 

        if ($self->{current_filename} =~ /\.psr$/) {
            store $data, $self->{current_filename};
        } elsif ($self->{current_filename} =~ /\.ddd$/) {
            open (DDD, "> $self->{current_filename}");
            print DDD new Data::Dumper([$data])->Dump;
            close DDD;
        } else {
            $self->{GUI}->Error("Invalid file");
        }
    } else {
        $self->cmdSaveAs();
    }
}



sub cmdSaveAs {
    my $self = shift;

    my $save = $self->{current_filename};
    $self->{current_filename} = $self->{GUI}->getSaveFilename();

    my $data = $self->getData()->getRoot(); 

    if ($self->{current_filename} =~ /\.psr$/) {
        store $data, $self->{current_filename};
    } elsif ($self->{current_filename} =~ /\.ddd$/) {
        open (DDD, "> $self->{current_filename}");
        print DDD new Data::Dumper([$data])->Dump;
        close DDD;
    } else {
        $self->{GUI}->Error("Invalid file");
        $self->{current_filename} = $save;
    }

    unless ($self->{current_filename}) {
        $self->{current_filename} = $save;
    }
}



sub cmdSaveOptions {
    my $self = shift;

    $self->{DATA}->saveConfig();
}



sub cmdSearch {
    my $self = shift;

    my $result = $self->{GUI}{dlg}{search}{dialog}->Show();

    return if ($result eq 'Cancel');

    unless ($self->{DATA}->getOption('search')) {
        $self->toggle('search');
    }

    $self->{GUI}->clearSearch();

    # L@@K need to impliment
#	my $list;
#	if ($self->{tk}{opts}{searchvalue}{root}) {
#		$list = $self->find_matches($self->{root}, "\$ROOT->")
#	} else {
#		$list = $self->find_matches($self->{tk}{col}[-1]{r}, $self->{pathstr})
#	};

}



sub getData {
    my $self = shift;
    return $self->{DATA};
}



sub show {
    my $self = shift;
    $self->{GUI}->display();    
}



sub toggle {
    my $self = shift;
    my $name = shift;
    my $mutex = {
        hlist   => ['browser'],
        browser => ['hlist'],
    };
    
    my $show = $self->{DATA}->toggleConfig($name);
    $self->{GUI}->showOption($name, $show);

    if (exists $mutex->{$name}) {
        for my $flip (@{$mutex->{$name}}) {
            my $flipshow = $self->{DATA}->toggleConfig($flip);
            $self->{GUI}->showOption($flip, $flipshow);
        }
    }
}












#sub get_tkv {
#	my $tkv = shift;
#
#	my ($t, $kv) = ($tkv =~ /^([\@\$\%])\s+([\s\S]*)$/sm);
#	my ($k, $v) = (split(/\s*\=\s+/, $kv, 2), '', '');
#
#	return ($t, $k, $v);
#}
#
######
## remove_rhs_columns - Used to colapse columns to the right of the selected column
##   in the list view.
##
#sub remove_rhs_columns {
#	my $self = shift;
#	my $col = shift || $self->{active};           # Active column
#	
#	# While there are columns to the right
#	while ($#{$self->{tk}{col}} > $col) {
#
#		# Remove the column widget from the tk global, get its parent and destroy
#		my $c = pop @{$self->{tk}{col}};
#		my $p = $c->{w}->parent;
#		$p->destroy;
#		
#		# Clean up path, ref and filter widgets
#		pop @{$self->{path}{a}};
#	}
#	
#	$self->set_scrollbar;
#}
#
#
#
#sub update_value {
#	my $self = shift;
#
#	my $c = $self->{tk}{col}[$self->{active}];
#
#	my $v = $self->{value};
#	
#	foreach my $item ($self->get_list_items($c->{w})) {
#		my ($t, $k) = get_tkv $item;
#		next unless ($t eq "\$");
#
#		if (arrayref($c->{r})) {
#			$k =~ s/\[|\]//g;
#			$c->{r}[$k] = $v;
#		}
#		$c->{r}{$k} = $v if (hashref($c->{r}));
#	}
#
#	$self->refresh_list($self->{active});
#}
#
#
#
#sub refresh_list {
#	my $self = shift;
#	
#	my $c = shift || $self->{active} || 0;
#
#	my $w = $self->{tk}{col}[$c]{w};
#	my $r = $self->{tk}{col}[$c]{r};
#
#	$self->{tk}{filter}{key}{$c} = '.' if $self->{tk}{filter}{key}{$c} eq '';
#	$self->{tk}{filter}{value}{$c} = '.' if $self->{tk}{filter}{value}{$c} eq ''; 
#
#	my @list;
#	my @vals;
#	my @sel = $w->curselection;
#
#	my $hash  = hashref($r);
#	my $array = arrayref($r);
#	
#	@vals = sort keys %{$r} if $hash;
#	@vals = @{$r}           if $array;
#
#	my $ndx = -1;
#	
#	foreach my $k (@vals) {
#
#		# Filtered on key?
#		$ndx++ if $array;
#		if ($hash && $self->{tk}{opts}{filters}) {
#			next unless $k =~ /$self->{tk}{filter}{key}{$c}/;
#		}
#		if ($array && $self->{tk}{opts}{filters}) {
#			next unless $ndx =~ /$self->{tk}{filter}{key}{$c}/;
#		}
#
#		my $val;
#		my $name = $k;
#
#		$val = $r->{$k}    if $hash;
#		$val = $k          if $array;
#
#		$name = "[" . $ndx . "]" if $array;
#
#		# L@@K Add -- Filtered on value?
##		if ($self->{tk}{opts}{filters}) {
##			if (defined $val) { 
##				next unless $val =~ /$self->{tk}{filter}{value}{$c}/;
##			} else {
##				next if ($self->{tk}{filter}{value}{$c} ne ".");
##			}
##		}
#
#		# Make list entry
#		my $pre = "\$";
#
#		if (hashref($val)) {
#			$pre = '%';
#			$val = '';
#		} elsif (arrayref($val)) {
#			$pre  = '@';
#			$val  = '';
#		} else {
#			$val = (defined $val) ? " = $val" : " = <undef>";
#		}
#
#		push @list, "$pre $name$val";
#
#	}
#
#	# Clear and fill list widget
#	$w->delete(0, 'end');
#	$w->insert(0, @list);
#
#	# Reset selections
#    foreach my $s (@sel) {
#        $w->selectionSet($s);
#    }
#
#	# Update path
#	$self->{pathstr} = join ('', @{$self->{path}{a}});
#}
#
#sub get_list_items {
#	my $self = shift;
#	my $w   = shift;
#	
#	return wantarray ? map {$w->get($_)} $w->curselection : $w->get(($w->curselection)[0]);
#}
#	
#
#
#sub select_list_path {
#	my $self = shift;
#	my $c   = shift;
#	my $ndx = shift;
#
#	$self->{tk}{col}[$c]{w}->selectionClear(0, 'end');
#	$self->{tk}{col}[$c]{w}->selectionSet($ndx);
#	$self->{tk}{col}[$c]{w}->see($ndx);
#	$self->list_select($c);
#}
#
#
#
#sub path_select {
#	my $self = shift;
#
#	my $path = $self->get_list_items($self->{tk}{search}{list});
#
#	$path =~ s/^\$ROOT->//;
#	
#	my $pndx = 0;
#	my %lu;
#	my $ref = $self->{root};
#
#
#	if ($self->{tk}{opts}{hlist}) {
#		$self->hlist_refresh_root;
#	} else {
#		foreach my $c (keys %{$self->{tk}{filter}{key}}) {
#			$self->{tk}{filter}{key}{$c} = '.';
#			$self->{tk}{filter}{value}{$c} = '.';
#		}
#	}
#		
#	my $hlistpath = '';
#
#	while ($path =~ /^[\{\[]/) {
#		
#		my $ndx;
#		my $pp;
#		if ($path =~ /^\{/) {
#			foreach my $k (keys %{$ref}) {
#				my $nk = $k;
#				$nk =~ s/([\[\]\{\}\$\%\@\|\&\?\.\+\*\^])/\\$1/g;
#				if ($path =~ s/^\{$nk\}//) {
#					$pp = $k;
#					last;
#				}
#			}
#
#			unless ($self->{tk}{opts}{hlist}) {
#				map {s/^\S+\s+//; $_ = (split /\s+\=\s+/)[0]; $lu{$_} = $ndx++} $self->{tk}{col}[$pndx]{w}->get(0, 'end');
#				$ndx = $lu{$pp};
#			}
#			$ref = $ref->{$pp};
#		} elsif ($path =~ /^\[/) {
#			$ndx = $1 if ($path =~ s/^\[(\d+)\]//);
#			$ref = $ref->[$ndx];
#			$pp = $ndx;
#		}
#
#		if ($self->{tk}{opts}{hlist}) {
#			$hlistpath .= ($hlistpath) ? "$::SEP$pp" : $pp;
#			$self->{tk}{hlist}{list}->selectionSet($hlistpath);
#			$self->hlist_select;
#			$self->{tk}{hlist}{list}->see($hlistpath);
#		} else {
#			$self->select_list_path($pndx, $ndx);
#		}
#		
#		$pndx++;
#	}
#	
#	if ($self->{tk}{opts}{hlist}) {
#		$self->{tk}{hlist}{list}->selectionClear();
#		$self->{tk}{hlist}{list}->selectionSet($hlistpath);
#	}
#}
#
#sub find_matches {
#
#	my $self = shift;
#	my $ref = shift;
#	my $path = shift;
#	my $visited = shift || {};
#	my $list = [];
#	
#	my $array = arrayref($ref);
#	my $hash  = hashref($ref);
#	$self->{tk}{opts}{searchvalue}{str} ||= '.';
#	
#	my $i = $self->{tk}{opts}{searchvalue}{case} ? '' : 'i';
#
#	if ($hash) {
#		foreach my $k (sort keys %{$ref}) {
#			$self->{searchcount}++;
#			$self->{tk}{mw}->update unless $self->{searchcount} % 100;
#			
#			my $newpath = "$path" . "{$k}";
#			my $newref = $ref->{$k};
#			
#			if ((eval "\$k =~ /\$self->{tk}{opts}{searchvalue}{str}/$i" ) 
#				&& $self->{tk}{opts}{searchvalue}{key}){
#				$self->{tk}{search}{list}->insert('end', $newpath);
#			}
#			
#			if ((defined $newref) && !(ref $newref)) {
#				if ((eval "\$newref =~ /\$self->{tk}{opts}{searchvalue}{str}/$i" ) 
#					&& $self->{tk}{opts}{searchvalue}{val}){
#					$self->{tk}{search}{list}->insert('end', "$newpath = $newref");
#				}
#				next;
#			}
#			unless (exists $visited->{"$newref"}) {
#				$visited->{"$newref"} = 1;
#				$self->find_matches($newref, $newpath, $visited);
#			}
#		}
#	}
#
#	if ($array) {
#		foreach my $k (0..$#{$ref}) {
#			$self->{searchcount}++;	
#			$self->{tk}{mw}->update unless $self->{searchcount} % 100;
#			my $newpath = "$path" . "[$k]";
#			my $newref = $ref->[$k];
#			
#			if ((eval "\$k =~ /\$self->{tk}{opts}{searchvalue}{str}/$i" ) 
#				&& $self->{tk}{opts}{searchvalue}{key}) {
#				$self->{tk}{search}{list}->insert('end', $newpath);
#			}
#			if ((defined $newref) && !(ref $newref)) {
#				if ((eval "\$newref =~ /\$self->{tk}{opts}{searchvalue}{str}/$i" ) 
#					&& $self->{tk}{opts}{searchvalue}{key}){
#					$self->{tk}{search}{list}->insert('end', "$newpath = $newref");
#				}
#				next;
#			}
#
#			unless (exists $visited->{"$newref"}) {
#				$visited->{"$newref"} = 1;
#				$self->find_matches($newref, $newpath, $visited);
#			}
#		}
#	}
#}
#
#
#
#sub exec_command {
#	my $self = shift;
#
#	my $script = $self->{tk}{command}{text}->get('1.0', 'end');
#	$script =~ s/~->/\$self->{root}/gsm;
#
#	my ($rfh, $wfh) = FileHandle::pipe;
#	
#	die unless $rfh;
#	die unless $wfh;
#	
#	select($wfh);
#	eval $script;
#	$wfh->close;
#	select(STDOUT);
#	my $output; 
#	
#	$output = join '', $rfh->getlines;
#	$rfh->close;
#
#	$self->{tk}{command}{out}->insert('end', $output);
#}
#
#
#
#sub scroll_browser {
#	my $self = shift;
#	my ($type, $amt, $size) = @_;
#	my $vw = 5.0;
#
#	my $init_left_most = $self->{leftmost};
#
#	if ($type eq 'moveto') {
#		$self->{leftmost} = int ($amt * @{$self->{tk}{col}});
#	}
#
#	if ($type eq 'scroll') {
#		if ($size eq 'pages') {
#			$amt *= ($vw -1);
#		}
#		$self->{leftmost} += $amt;
#	}
#	
#	while ($self->{leftmost} < 0) {
#		$self->{leftmost}++;
#	}
#
#	while ($self->{leftmost} > @{$self->{tk}{col}} - $vw) {
#		$self->{leftmost}--;
#	}
#
#	$self->{leftmost} = 0 if ($self->{leftmost} < 0);
#
#	$self->set_scrollbar;
#
#	return if ($init_left_most == $self->{leftmost});
#
#	foreach my $ndx (0..$#{$self->{tk}{col}}) {
#		my $w = $self->{tk}{col}[$ndx]{w}->parent;
#		$w->packForget();
#
#		if (($ndx >= $self->{leftmost}) and ($ndx < $self->{leftmost} + $vw)) {
#			$w->pack(
#					 -anchor => 'w',
#					 -side   => 'left', 
#					 -fill   => 'y', 
#					 -expand => 'both',
#					 );
#		}
#	}
#}
#
#
################################################################################
#### GUI Actions
####
#
## OPTION MENU
#sub m_toggle_filters {
#	my $self = shift;
#	
#	foreach my $c (0..$#{$self->{tk}{col}}) {
#		if ($self->{tk}{opts}{filters}) {
#			$self->{tk}{col}[$c]{kf}->pack(
#										  -anchor => 'w',
#										  -side   => 'top', 
#										  -fill   => 'x',
#										  );
#			$self->{tk}{col}[$c]{vf}->pack(
#										  -anchor => 'w',
#										  -side   => 'top', 
#										  -fill   => 'x',
#										  );
#		} else {
#			$self->{tk}{col}[$c]{kf}->packForget;
#			$self->{tk}{col}[$c]{vf}->packForget;
#		}
#		$self->refresh_list($c);
#	}
#}
#
#
#
## TOOL MENU
#sub m_search {
#	my $self = shift;
#
#	my $d = $self->{tk}{dlg}{search};
#	my $button = $d->Show;
#
#	return if ($button eq 'Cancel');
#
#	unless ($self->{tk}{opts}{search}) {
#		$self->{tk}{opts}{search} = 1;
#		$self->m_toggle_window('search');
#	}
#
#	$self->{searchcount} = 0;
#	$self->{tk}{search}{list}->delete(0, 'end');
#
#	my $list;
#	if ($self->{tk}{opts}{searchvalue}{root}) {
#		$list = $self->find_matches($self->{root}, "\$ROOT->")
#	} else {
#		$list = $self->find_matches($self->{tk}{col}[-1]{r}, $self->{pathstr})
#	};
#		
#}
#
#
#
## POPUP MENUS
#
#sub add_data {
#	my $self = shift;
#	my $ref = shift;
#	my $ndx = shift;
#	my $t   = shift;
#
#	my $val = $self->{value};
#	$val = [] if $t =~ /Array/;
#	$val = {} if $t =~ /Hash/;
#	
#	$ref->{$ndx} = $val if (hashref($ref) and !exists $ref->{$ndx});
#
#	push @{$ref}, $val  if arrayref($ref);
#
#	return;
#
#
##	if (hash_ref($r)) {
##		unless (exists $r->{$k}) {
##			$r->{$k} = $v if ($t =~ /Scalar/);
##			$r->{$k} = [] if ($t =~ /Array/);
##			$r->{$k} = {} if ($t =~ /Hash/);
##		}
##	}
##
##	if (array_ref($r)) {
##		push @{$r}, $v if ($t =~ /Scalar/);
##		push @{$r}, [] if ($t =~ /Array/);
##		push @{$r}, {} if ($t =~ /Hash/);
##	}
#
#}
#
#
#
## MISC. GUI OPERATIONS
#sub set_scrollbar {
#	my $self = shift;
#
#	my $depth = @{$self->{tk}{col}};
#
#	my $amtl = $depth ? (1 / $depth) * $self->{leftmost} : 0;
#	my $amtr = $depth ? (1 / $depth) * ($self->{leftmost} + 5.0) : 1;
#	$amtr = 1 if ($amtr > 1.0);
#
#	$self->{tk}{xscroll}->set($amtl, $amtr);
#}
#
#
#
################################################################################
#### GUI Building
####
#


1;

__END__